perm filename DRAW.F4[DRW,LCS]5 blob sn#502487 filedate 1980-03-25 generic text, type T, neo UTF8
00100	C***** FOLLOWING IS FILE 'DRAW.CMD' **********
00200	C***	DRAW[DRW,LCS],MSSIO[MS,LCS],CB[DRW,LCS]
00300	C***	,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
00400	C***	,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
00500	
00600	C  'G' OR <CR> = GET.  'A'=ADD TO COMBINED FILE.
00700	C P=PLOT 
00800	C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
00900	C  F=JUMP AND BEGIN FILL SECTION.  FX=EXIT AND FILL ALL.
01000	C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
01100	C  'O' MAKES CURRENT DPY INTO OVERLAY.
01200	 
01300	C VECTORS ARE PACKED 1 TO A WORD IN THE FOLLOWING STRANGE MANNER:
01400	C          ABCDEFGHI REPRESENTS A 9-DIGIT NUMBER.
01500	C   A=0=VISIBLE VECT., A=1=INVISIBLE, A=2=INVIS. AND START OF FILLED AREA.
01600	C   BCDE=THE X COORDINATE, B=0=POSITIVE, B=1=NEG. (THE RANGE IS + OR - 999)
01700	C   FGHI=THE Y COORDINATE, F=0=POSITIVE, F=1=NEG. (THE RANGE IS + OR - 999)
01800	C    THUS   100671025  MEANS INVIS. VECTOR TO X=67, Y=-25.
01900	
02000		COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10) /INCR/INCR
02100	CIRC	COMMON /RC/MCLEF(400)
02200		COMMON /RC/MCLEF(400),IST(4000)
02300		1 /GRID/GRID
02400	CIRC	1 /DPY/NDP,IOV,GRID
02500	C	NDP=BUFFER NUM FOR OUTPUT, IOV=BUFFER NUM FOR INPUT
02600		DIMENSION JST(450),INP(72),V(30)
02700		COMMON/ZN/SCLEF(2,400),DDD /ED/KED,NEXT,NN,NX,NY,J
02800		COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
02900		COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,RJB,CENTR
03000	CIRC	COMMON/LETS/LETS(14)  /FL/IC,N,NQ,RZ
03100	CIRC	DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
03200	CIRC	1'O','L','W','H'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
03300		COMMON/LETS/LETS(15)  /FL/IC,N,NQ,RZ
03400		DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
03500		1'O','L','W','H','Q'/, ISIZE/2000/, RJB/-20./,CENTR/-26./
03600		EQUIVALENCE (MM,SCLEF(1,1)),(V2,V(2)),(V3,V(3)),(N,INP),
03700		1 (IVI,V1,V),(LETS(13),LW),(LETS(14),LH),(JC,INP(2)),(JS,
03800		1 INP(3)),(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4)
03900		1,LD),(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
04000		1,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LO),(LETS(12),LLL)
04100		1,(IST2,IST(2))
04200	CIRC	CALL ERRSET(0)
04300	CIRC	CALL DPYSET(ISIZE,1)
04400	CIRC	NDP=1
04500	CIRC	IOV=1
04600		RSZ=0
04700		GRID=0
04800	39	MCLEF(1)=0
04900	CIRC	CALL DPYCLR
05000	CIRC	CALL DPYOUT(NDP)
05100		CALL DPYSET(1,IST,4000)
05200		CALL HYDPOG(1)
05300	C  IF AN OVERLAY HAS BEEN SETUP IT SHOULD STILL DISPLAY AFTER DPYCLR.
05400	C  THIS IS FOR 'Z' (ZERO THE DRAWING)
05500	C DPYSET INITIALIZES GRAPHICS PACKAGE AND EXPANDS CORE FOR BUFFER.
05600		MM=0
05700		K=1
05800	17	FORMAT(' *',$)
05900	18	FORMAT(' H=HELP')
06000		TYPE 18
06100	91	TYPE 17
06200	55	FORMAT(I,2F)
06300	50  	FORMAT(72A1)
06400	500	XSZ=RSZ
06500		ACCEPT 50,INP
06600		CALL RREAD(INP,V)      
06700	C V ARRAY HAS ZEROS IF ALPHAS IN INP ARRAY.
06800		RSZ=V2
06900		GRID=V3
07000	51	IF(RSZ.EQ.0)RSZ=XSZ
07100	C  TO SAVE SIZE FACTOR WHEN REDRAWING.
07200		MORE=-1
07300		CALL LO2UP(N)
07400		CALL LO2UP(JC)
07500		CALL LO2UP(JS)
07600		IF(RSZ.EQ.0)RSZ=9.0
07700		IF(GRID.NE.0.AND.N.NE.LP)CALL GRIDS
07800	CIRC	DO 191 K=1,14       
07900		DO 191 K=1,15
08000	C                             G  S  M  D  R  P  A  F  E  Z
08100	191	IF(LETS(K).EQ.N)GO TO(30,36,32,33,32,70,36,79,38,39,
08200		1 56,11,12,16,32)K
08300	C         O   L  W  H  Q
08400		IF(N.NE.' ')TYPE 391
08500		GO TO 91
08600	391	FORMAT(' UNKNOWN COMMAND'/)
08700	C  'O' MAKES CURRENT DPY INTO OVERLAY
08800	
08900	16	TYPE 100
09000	C 'HELP'
09100		GO TO 91
09200	
09300	11	CALL LIST(0)
09400	C TYPE OUT LIST OF COORDINATES.
09500		GO TO 91
09600	
09700	12	TYPE 41
09800	C WRITE LIST OF COORDS ON DISK FILE
09900		CALL A5IN(JC)
10000		IF(N.NE.LW)GO TO 13
10100		CALL LIST(JC)
10200		GO TO 91
10300	
10400	CIRC13	OPEN(UNIT=1,FILE=JC)
10500	13	CALL IFILE (1,JC)
10600	14	READ(1,5,END=15)N,JC,JS,JZ
10700	C READ IN EDIT FILE OF COORDS.  N, X, Y, Z   (N IS COUNT NUMB.)
10800		JZ=JZ*100000000
10900	C JZ=1=INVIS  =2=START FILLER (INVIS)
11000		CALL REPACK(JC,JS,JZ,MCLEF(N+1))
11100		GO TO 14
11200	15	MCLEF(1)=N+1
11300	CIRC	CALL DPYCLR
11400		IST2=0
11500		CALL DPYSET(1,IST,4000)
11600		GO TO 334
11700	
11800	33	IF(JS.NE.LLL)GO TO 38
11900		N=LZ
12000	C  DEL=DELETE FROM COMB. FILE.   (JS=LLL)
12100		GO TO 36
12200	38	KED=N
12300		MM=MCLEF(1)
12400		IF(MM.NE.0)GO TO 92
12500	C  ADD TO DRAWING?
12600		GO TO 3
12700	
12800	CIRC56	CALL DPYSET(400,2)
12900	56	CALL POG2
13000	C INITIALIZE THE OVERLAY
13100	CIRC	IOV=2
13200	CIRC	NDP=2
13300	CIRC	CALL RDRAW(2,MCLEF(1),MCLEF)
13400		CALL RDRAW(3,2,MCLEF(1),MCLEF)
13500	CIRC	IOV=1
13600	CIRC	CALL DPYOUT(NDP)
13700	C SAVE OVERLAY IN SPECIAL MEMORY
13800		GO TO 91
13900	36 	CALL CMBN
14000		GO TO 91
14100	32 	IF(JC.EQ.LE)GO TO 12
14200	C RE=READ EDIT FILE FOR VECTORS
14300		CALL DPYSET(1,IST,4000)
14400		IST2=0
14500		CALL SHIFT(MCLEF(2),MCLEF(1),N)
14600	C  FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
14700		J=1
14800		JC=0
14900		GO TO 333
15000	291	FORMAT(A2,A5)
15100	30 	REREAD 291,NM,NM
15200		CALL LO2UP(NM)
15300		IF(JC.EQ.LM)NM=' '
15400		IF(NM.NE.' ')GO TO 293
15500	130	TYPE 41
15600		IF(JC.EQ.LM)GO TO 194
15700		IF(N.EQ.LS)GO TO 194
15800	C 'GET'  REINIT VARIOUS THINGS
15900		MCLEF(1)=0
16000		MM=0
16100		K=1
16200	194	IF(JC.EQ.LM)MORE=0
16300		JQ=JC
16400		JC=0
16500		JM=1
16600		IF(MCLEF(1).EQ.0)GO TO 193
16700		JM=MCLEF(1)+1
16800	193	CALL A5IN(NM)
16900		IF(NM.EQ.' ')NM=LASTNM
17000		IF(NM.EQ.' ')GO TO 91
17100		IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 91
17200	C  'B' OR '99'  WILL BACKUP
17300	293	LASTNM=NM
17400		IF(LOOKF(NM).EQ.0)GO TO  130
17500	C  'FAIL' ROUTINE TO CHECK ON LOOKUP    0=FILE NOT FOUND.
17600		CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
17700	C  -1=READ
17800		J=1
17900		IF(KCLEF(2).EQ.0)GO TO 290
18000		TYPE 1100
18100		ACCEPT 55,J
18200		J=J+1
18300	C  ITEMS ARE NUMBERED  0 THROUGH 9 (10 ITEMS).
18400		IF(J.GT.10)GO TO 191
18500	290	IC=KCLEF(J)+JST(KCLEF(J))-1
18600		IF(IC.GT.350)TYPE 1110
18700	60	JZ=1
18800		IF(MORE.EQ.0)JZ=JM
18900		L=KCLEF(J)-1
19000		M=JST(L+1)+JZ-1
19100		IF(MORE.NE.0)GO TO 161
19200		M=M-1
19300		L=L+1
19400	161	DO 61 K=JZ,M
19500		L=L+1
19600	61	MCLEF(K)=JST(L)
19700		MCLEF(1)=M
19800	1100	FORMAT(' ITEM NUM?'/)
19900	7	IF(MORE)GO TO 70
20000		DO 771 K=2,JM-1
20100	771	IF(MCLEF(K).GE.200000000)GO TO 772
20200		GO TO 70
20300	C PUTS FILLER TO END
20400	C  MOVES OUTLINE UP FRONT
20500	772	M=MCLEF(1)
20600		DO 773 L=K,JM
20700		M=M+1
20800	773	MCLEF(M)=MCLEF(L)
20900		K=JM-K  
21000	1774	DO 774 L=JM,M
21100	774	MCLEF(L-K)=MCLEF(L)
21200		CALL DPYSET(1,IST,4000)
21300		IST2=0
21400		GO TO 3
21500	
21600	70	IF(N.NE.LP)GO TO 3
21700	CIRC	OPEN(UNIT=1,FILE='PLOT.PLT',MODE='IMAGE')
21800	CIRC	CALL SAVBUF(1)
21900	C WRITES VERSATEC FILE   PLOT.PLT
22000	CIRC	CLOSE(UNIT=1)
22100	CIRC	TYPE 441
22200	CIRC	GO TO 91
22300	CIRC441	FORMAT(' ******* PLOT.PLT WAS WRITTEN *****')
22400		
22500	3	IF(N.NE.LD)MM=0
22600	C  RESET IF NOT GOING TO DRAWIT
22700	333	IF(N.EQ.LP)GO TO 337
22800	CC	CALL DPYCLR
22900		IF(N.GE.0)GO TO 337
23000		IF(N.EQ.LG)GO TO 337
23100		IF(N.EQ.LM)GO TO 337
23200		IF(N.NE.LR)GO TO 92
23300	337	IF(JS.EQ.LZ)GO TO 306
23400		IF(JS.NE.LS)GO TO 338
23500		CALL SMOOTH(JS)
23600		GO TO 436
23700	338	IC=-1
23800		MM=1
23900		DO 335 K=2,MCLEF(1)
24000		IF(MCLEF(K).LT.200000000)GO TO 335
24100		IC=K
24200		GO TO 334
24300	C FOR 1ST LOC. OF MCLEF IN FILLER
24400	335	CONTINUE
24500	CIRC334	CALL RDRAW(2,MCLEF(1),MCLEF)
24600	334	CALL RDRAW(1,2,MCLEF(1),MCLEF)
24700	C 1=DPYOUT(1)
24800	CIRC	CALL DPYOUT(NDP)
24900		GO TO 91
25000	79	IF(IC.LT.0)GO TO 91
25100	C  FILLS IT.
25200	C  IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
25300		JZ=N
25400		KK=0
25500		IF(JC.NE.LS)GO TO 206
25600	C  TYPE 'FS' TO FILL AND SMOOTH
25700	306	CALL SMOOTH(0)
25800	C  SMOOTHS AND FILLS
25900		GO TO 436
26000	206	RR=RSZ
26100		DO 205 J=IC,MCLEF(1)
26200		CALL UNPACK(M,N,LL,MCLEF(J))
26300		KK=KK+1
26400		NF(KK)=0
26500		IF(LL.GE.100000000)NF(KK)=3
26600		QF(KK)=(M+RJB)*RR
26700	205	RF(KK)=(N+CENTR)*RR
26800		NF(1)=KK
26900		CALL FILLQ(QF,RF,NF)
27000	436	GO TO 91
27100	
27200	5	FORMAT(12I)
27300	100   FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/
27400		1' E=EDIT,   P=PLOT,  RE=READ EDIT FILE,  W=WRITE EDIT FILE'/
27500		1' LI=LIST COORDINATES'/
27600		1,' DEL=DELETE ITEM FROM FILE,  O=OVERLAY,  Z=ZERO DRAWING'/,
27700		1' F=FILL       N1=IMAGE SIZE, N2=1=GRID  -1=DELETE OVERLAY'/)
27800	C  N1=20 TO CHANGE SHAPE
27900	
28000	CIRC92 	CALL DPYCLR
28100	C92	CALL HYDPOG(1)
28200	92	CALL DPYSET(1,IST,4000)
28300	CIRC	CALL RDRAW(2,MCLEF(1),MCLEF)
28400		CALL RDRAW(1,2,MCLEF(1),MCLEF)
28500	C THIS CLEARS FILLER LINES
28600		CALL DRAWIT
28700	  	N=0
28800		GO TO 3
28900	
29000	403	FORMAT(' WRITE OVER ',A5,'.DMD?  ',$)
29100	41	FORMAT(' TYPE FILE NAME'/)
29200	110	FORMAT(' TOTAL WDS=',I3)
29300	1110	FORMAT(' ********************************',/
29400		1      ' ***** WARNING - LIMIT=350 ******',/
29500		1      ' ********************************')
29600		END